home *** CD-ROM | disk | FTP | other *** search
/ Enter 2004 January / enter-2004-01.iso / files / maxima-5.9.0.exe / {app} / share / maxima / 5.9.0 / src / numerical / slatec / dbsi0e.lisp < prev    next >
Encoding:
Text File  |  2003-02-09  |  12.1 KB  |  191 lines
  1. ;;; Compiled by f2cl version 2.0 beta 2002-05-06
  2. ;;; 
  3. ;;; Options: ((:prune-labels nil) (:auto-save t) (:relaxed-array-decls t)
  4. ;;;           (:coerce-assigns :as-needed) (:array-type ':simple-array)
  5. ;;;           (:array-slicing nil) (:declare-common nil)
  6. ;;;           (:float-format double-float))
  7.  
  8. (in-package "SLATEC")
  9.  
  10.  
  11. (let ((nti0 0)
  12.       (ntai0 0)
  13.       (ntai02 0)
  14.       (xsml 0.0)
  15.       (bi0cs (make-array 18 :element-type 'double-float))
  16.       (ai0cs (make-array 46 :element-type 'double-float))
  17.       (ai02cs (make-array 69 :element-type 'double-float))
  18.       (first nil))
  19.   (declare (type f2cl-lib:logical first)
  20.            (type (simple-array double-float (69)) ai02cs)
  21.            (type (simple-array double-float (46)) ai0cs)
  22.            (type (simple-array double-float (18)) bi0cs)
  23.            (type double-float xsml)
  24.            (type f2cl-lib:integer4 ntai02 ntai0 nti0))
  25.   (f2cl-lib:fset (f2cl-lib:fref bi0cs (1) ((1 18))) -0.07660547252839145)
  26.   (f2cl-lib:fset (f2cl-lib:fref bi0cs (2) ((1 18))) 1.9273379539938083)
  27.   (f2cl-lib:fset (f2cl-lib:fref bi0cs (3) ((1 18))) 0.22826445869203013)
  28.   (f2cl-lib:fset (f2cl-lib:fref bi0cs (4) ((1 18))) 0.013048914667072906)
  29.   (f2cl-lib:fset (f2cl-lib:fref bi0cs (5) ((1 18))) 4.344270900816488e-4)
  30.   (f2cl-lib:fset (f2cl-lib:fref bi0cs (6) ((1 18))) 9.422657686001936e-6)
  31.   (f2cl-lib:fset (f2cl-lib:fref bi0cs (7) ((1 18))) 1.4340062895106911e-7)
  32.   (f2cl-lib:fset (f2cl-lib:fref bi0cs (8) ((1 18))) 1.613849069661749e-9)
  33.   (f2cl-lib:fset (f2cl-lib:fref bi0cs (9) ((1 18))) 1.39665004453567e-11)
  34.   (f2cl-lib:fset (f2cl-lib:fref bi0cs (10) ((1 18))) 9.579451725505446e-14)
  35.   (f2cl-lib:fset (f2cl-lib:fref bi0cs (11) ((1 18))) 5.333981859862503e-16)
  36.   (f2cl-lib:fset (f2cl-lib:fref bi0cs (12) ((1 18))) 2.458716088437471e-18)
  37.   (f2cl-lib:fset (f2cl-lib:fref bi0cs (13) ((1 18))) 9.53568089024877e-21)
  38.   (f2cl-lib:fset (f2cl-lib:fref bi0cs (14) ((1 18))) 3.1543820397214273e-23)
  39.   (f2cl-lib:fset (f2cl-lib:fref bi0cs (15) ((1 18))) 9.004564101094639e-26)
  40.   (f2cl-lib:fset (f2cl-lib:fref bi0cs (16) ((1 18))) 2.2406473691236703e-28)
  41.   (f2cl-lib:fset (f2cl-lib:fref bi0cs (17) ((1 18))) 4.903034603242837e-31)
  42.   (f2cl-lib:fset (f2cl-lib:fref bi0cs (18) ((1 18))) 9.508172606122669e-34)
  43.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (1) ((1 46))) 0.07575994494023797)
  44.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (2) ((1 46))) 0.007591380810823346)
  45.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (3) ((1 46))) 4.15313133892375e-4)
  46.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (4) ((1 46))) 1.0700764634390732e-5)
  47.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (5) ((1 46))) -7.901179979212894e-6)
  48.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (6) ((1 46))) -7.826143501438751e-7)
  49.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (7) ((1 46))) 2.7838499429488706e-7)
  50.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (8) ((1 46))) 8.252472600612029e-9)
  51.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (9) ((1 46))) -1.2044639455201991e-8)
  52.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (10) ((1 46))) 1.5596485985060765e-9)
  53.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (11) ((1 46))) 2.292556367103317e-10)
  54.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (12) ((1 46))) -1.1916228842790651e-10)
  55.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (13) ((1 46))) 1.75785491603241e-11)
  56.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (14) ((1 46))) 1.1282244632189005e-12)
  57.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (15) ((1 46))) -1.1468486259272989e-12)
  58.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (16) ((1 46))) 2.715592054803663e-13)
  59.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (17) ((1 46))) -2.415874666562688e-14)
  60.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (18) ((1 46))) -6.084469888255125e-15)
  61.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (19) ((1 46))) 3.1457050771754774e-15)
  62.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (20) ((1 46))) -7.172212924871187e-16)
  63.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (21) ((1 46))) 7.874493403454103e-17)
  64.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (22) ((1 46))) 1.0048027530094623e-17)
  65.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (23) ((1 46))) -7.566895365350534e-18)
  66.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (24) ((1 46))) 2.1503801068761202e-18)
  67.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (25) ((1 46))) -3.754858341830875e-19)
  68.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (26) ((1 46))) 2.3540658422269925e-20)
  69.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (27) ((1 46))) 1.1146676120479285e-20)
  70.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (28) ((1 46))) -5.39889188439699e-21)
  71.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (29) ((1 46))) 1.4395987922407524e-21)
  72.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (30) ((1 46))) -2.591916360111093e-22)
  73.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (31) ((1 46))) 2.2381331839985838e-23)
  74.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (32) ((1 46))) 5.250672575364771e-24)
  75.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (33) ((1 46))) -3.2499041385332306e-24)
  76.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (34) ((1 46))) 9.924214103205037e-25)
  77.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (35) ((1 46))) -2.1649922542446692e-25)
  78.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (36) ((1 46))) 3.233609471943594e-26)
  79.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (37) ((1 46))) -1.1846202073967427e-27)
  80.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (38) ((1 46))) -1.281671853950499e-27)
  81.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (39) ((1 46))) 5.82701518227939e-28)
  82.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (40) ((1 46))) -1.6682223260261095e-28)
  83.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (41) ((1 46))) 3.62530951054157e-29)
  84.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (42) ((1 46))) -5.733627999055714e-30)
  85.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (43) ((1 46))) 3.7367967220630977e-31)
  86.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (44) ((1 46))) 1.6020739831568523e-31)
  87.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (45) ((1 46))) -8.700424864057231e-32)
  88.   (f2cl-lib:fset (f2cl-lib:fref ai0cs (46) ((1 46))) 2.741320937937481e-32)
  89.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (1) ((1 69))) 0.054490411014108835)
  90.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (2) ((1 69))) 0.0033691164782556943)
  91.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (3) ((1 69))) 6.889758346916824e-5)
  92.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (4) ((1 69))) 2.891370520834757e-6)
  93.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (5) ((1 69))) 2.0489185894690634e-7)
  94.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (6) ((1 69))) 2.266668990498178e-8)
  95.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (7) ((1 69))) 3.396232025708386e-9)
  96.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (8) ((1 69))) 4.94060238822497e-10)
  97.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (9) ((1 69))) 1.1889147107846439e-11)
  98.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (10) ((1 69))) -3.1499165279632413e-11)
  99.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (11) ((1 69))) -1.3215811840447717e-11)
  100.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (12) ((1 69))) -1.7941785315068062e-12)
  101.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (13) ((1 69))) 7.180124451383666e-13)
  102.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (14) ((1 69))) 3.8527783827421425e-13)
  103.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (15) ((1 69))) 1.5400862175214097e-14)
  104.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (16) ((1 69))) -4.150569347287222e-14)
  105.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (17) ((1 69))) -9.554846698828307e-15)
  106.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (18) ((1 69))) 3.8116806693526223e-15)
  107.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (19) ((1 69))) 1.772560133056526e-15)
  108.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (20) ((1 69))) -3.4254856196772193e-16)
  109.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (21) ((1 69))) -2.827623980516584e-16)
  110.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (22) ((1 69))) 3.461222867697461e-17)
  111.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (23) ((1 69))) 4.4656214202967603e-17)
  112.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (24) ((1 69))) -4.8305044859441826e-18)
  113.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (25) ((1 69))) -7.233180487874755e-18)
  114.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (26) ((1 69))) 9.921475412173699e-19)
  115.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (27) ((1 69))) 1.1936508908459822e-18)
  116.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (28) ((1 69))) -2.4887098371508073e-19)
  117.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (29) ((1 69))) -1.9384264541609061e-19)
  118.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (30) ((1 69))) 6.444656697373444e-20)
  119.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (31) ((1 69))) 2.886051596289224e-20)
  120.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (32) ((1 69))) -1.6019549071749714e-20)
  121.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (33) ((1 69))) -3.2708150105923145e-21)
  122.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (34) ((1 69))) 3.686932283826409e-21)
  123.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (35) ((1 69))) 1.2682976480309505e-23)
  124.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (36) ((1 69))) -7.549825019377274e-22)
  125.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (37) ((1 69))) 1.502133571377835e-22)
  126.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (38) ((1 69))) 1.2651958835096486e-22)
  127.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (39) ((1 69))) -6.100998370083681e-23)
  128.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (40) ((1 69))) -1.2688096292601284e-23)
  129.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (41) ((1 69))) 1.6610160998907417e-23)
  130.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (42) ((1 69))) -1.5851943357658854e-24)
  131.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (43) ((1 69))) -3.3026454059682175e-24)
  132.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (44) ((1 69))) 1.3135809028392395e-24)
  133.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (45) ((1 69))) 3.689040246671157e-25)
  134.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (46) ((1 69))) -4.2101419104616883e-25)
  135.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (47) ((1 69))) 4.7919545910828665e-26)
  136.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (48) ((1 69))) 8.459470390221822e-26)
  137.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (49) ((1 69))) -4.0398009408728325e-26)
  138.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (50) ((1 69))) -6.434714653650433e-27)
  139.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (51) ((1 69))) 1.2257433988756661e-26)
  140.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (52) ((1 69))) -2.934391316025709e-27)
  141.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (53) ((1 69))) -1.9613113091949833e-27)
  142.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (54) ((1 69))) 1.5035203748221934e-27)
  143.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (55) ((1 69))) -9.588720515744825e-29)
  144.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (56) ((1 69))) -3.4833393808170454e-28)
  145.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (57) ((1 69))) 1.690903610263044e-28)
  146.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (58) ((1 69))) 1.9828665387356031e-29)
  147.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (59) ((1 69))) -5.317498081491816e-29)
  148.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (60) ((1 69))) 1.803306629888393e-29)
  149.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (61) ((1 69))) 6.213093341454892e-30)
  150.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (62) ((1 69))) -7.692189292772161e-30)
  151.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (63) ((1 69))) 1.858252826111702e-30)
  152.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (64) ((1 69))) 1.2375851422813955e-30)
  153.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (65) ((1 69))) -1.1022591204092239e-30)
  154.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (66) ((1 69))) 1.8862871180397048e-31)
  155.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (67) ((1 69))) 2.1601968722436593e-31)
  156.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (68) ((1 69))) -1.6054541249197435e-31)
  157.   (f2cl-lib:fset (f2cl-lib:fref ai02cs (69) ((1 69))) 1.9653529845942905e-32)
  158.   (setq first f2cl-lib:%true%)
  159.   (defun dbsi0e (x)
  160.     (declare (type double-float x))
  161.     (prog ((y 0.0) (dbsi0e 0.0) (eta 0.0f0))
  162.       (declare (type single-float eta) (type double-float dbsi0e y))
  163.       (cond
  164.        (first (setf eta (* 0.1f0 (f2cl-lib:freal (f2cl-lib:d1mach 3))))
  165.               (setf nti0 (initds bi0cs 18 eta))
  166.               (setf ntai0 (initds ai0cs 46 eta))
  167.               (setf ntai02 (initds ai02cs 69 eta))
  168.               (setf xsml (f2cl-lib:fsqrt (* 4.5 (f2cl-lib:d1mach 3))))))
  169.       (setf first f2cl-lib:%false%)
  170.       (setf y (coerce (abs x) 'double-float))
  171.       (if (> y 3.0) (go label20))
  172.       (setf dbsi0e (- 1.0 x))
  173.       (if (> y xsml)
  174.           (setf dbsi0e
  175.                   (* (exp (- y))
  176.                      (+ 2.75 (dcsevl (- (/ (* y y) 4.5) 1.0) bi0cs nti0)))))
  177.       (go end_label)
  178.      label20
  179.       (if (<= y 8.0)
  180.           (setf dbsi0e
  181.                   (/ (+ 0.375 (dcsevl (/ (- (/ 48.0 y) 11.0) 5.0) ai0cs ntai0))
  182.                      (f2cl-lib:fsqrt y))))
  183.       (if (> y 8.0)
  184.           (setf dbsi0e
  185.                   (/ (+ 0.375 (dcsevl (- (/ 16.0 y) 1.0) ai02cs ntai02))
  186.                      (f2cl-lib:fsqrt y))))
  187.       (go end_label)
  188.      end_label
  189.       (return (values dbsi0e nil)))))
  190.  
  191.